
 1000  *--------------------------------
 1010  *SAVE S.RANDOM KNUTH
 1020  *--------------------------------
 1030  *      FROM KNUTH'S "THE ART OF COMPUTER PROGRAMMING"
 1040  *                   VOLUME 2, PAGES 155-157.
 1050  *--------------------------------
 1060         .OR $300
 1070         .TF B.RANDOM KNUTH
 1080  *--------------------------------
 1090  NORMALIZE.FAC       .EQ $E82E
 1100  FMUL.FAC.BY.YA      .EQ $E97F
 1110  STORE.FAC.AT.YX.ROUNDED .EQ $EB2B
 1120  AS.QINT             .EQ $EBF2
 1130  AS.INT              .EQ $EC23
 1140  *--------------------------------
 1150  USER.VECTOR         .EQ $0A THRU $0C
 1160  FAC                 .EQ $9D THRU $A2
 1170  FAC.SIGN            .EQ $A2
 1180  FAC.EXTENSION       .EQ $AC
 1190  AS.SEED             .EQ $CA THRU $CD
 1200  *--------------------------------
 1210  LINK   LDA #$4C     "JMP" OPCODE
 1220         STA USER.VECTOR
 1230         LDA #RANDOM
 1240         STA USER.VECTOR+1
 1250         LDA /RANDOM
 1260         STA USER.VECTOR+2
 1270         RTS
 1280  *--------------------------------
 1290  *      R = USR (X)
 1300  *      IF X < 0 THEN RESEED WITH ABS(X)
 1310  *      IF X = 0 THEN R = REPEAT OF PREVIOUS VALUE
 1320  *      IF 0 < X < 2 THEN GENERATE NEXT SEED AND RETURN
 1330  *                    0 <= R < 1
 1340  *      IF X >= 2 THEN R = INT(RND*X)
 1350  *--------------------------------
 1360  RANDOM
 1370         LDA FAC.SIGN CHECK FOR RESEEDING
 1380         BMI .1       ...YES
 1390         LDA FAC      CHECK FOR X=0
 1400         BEQ .6       ...YES, REUSE LAST NUMBER
 1410  *---X --> RANGE------------------
 1420         LDX #RANGE
 1430         LDY /RANGE
 1440         JSR STORE.FAC.AT.YX.ROUNDED   $EB2B
 1450         JMP .4
 1460  *---PREPARE SEED-----------------
 1470  .1     LDA #0       MAKE SEED POSITIVE
 1480         STA FAC.SIGN
 1490         LDA FAC      LIMIT SEED TO 2^32-1
 1500         CMP #$A0
 1510         BCC .2
 1520         LDA #$A0
 1530         STA FAC
 1540  .2     JSR AS.QINT   $EBF2
 1550         LDX #3       COPY FAC INTO SEED
 1560  .3     LDA FAC+1,X
 1570         STA SEED,X
 1580         DEX
 1590         BPL .3
 1600  *---SEED*314159269+907633386-----
 1610  .4     LDX #0
 1620  .5     LDA SEED,X
 1630         STA MULTIPLIER
 1640         LDA C,X
 1650         STA SEED,X
 1660         JSR MULTIPLY
 1670         INX
 1680         CPX #4
 1690         BCC .5
 1700  *---LOAD SEED INTO FAC-----------
 1710  .6     LDX #5
 1720  .7     LDA FLT.SEED,X
 1730         STA FAC,X
 1740         DEX
 1750         BPL .7
 1760         LDA #0
 1770         STA FAC.EXTENSION
 1780         JSR NORMALIZE.FAC
 1790  *---SCALE TEST-------------------
 1800         LDA RANGE
 1810         CMP #$82     IS RANGE BETWEEN ZERO AND ONE?
 1820         BCC .8       ...YES
 1830  *---SCALE------------------------
 1840         LDA #RANGE
 1850         LDY /RANGE
 1860         JSR FMUL.FAC.BY.YA   $E97F
 1870         JSR AS.INT  $EC23
 1880  *---RETURN-----------------------
 1890  .8     RTS
 1900  *--------------------------------
 1910  MULTIPLY
 1920         STX BYTE.CNT
 1930         LDY #3
 1940  .1     LDA A,Y
 1950         STA MULTIPLICAND,X
 1960         DEY
 1970         DEX
 1980         BPL .1
 1990         LDY #8
 2000         BNE .2       ...ALWAYS
 2010  *--------------------------------
 2020  .5     CLC          DOUBLE THE MULTIPLICAND
 2030  .6     ROL MULTIPLICAND,X
 2040         DEX
 2050         BPL .6
 2060  .2     LSR MULTIPLIER
 2070         BCC .4
 2080         LDX BYTE.CNT
 2090         CLC
 2100  .3     LDA MULTIPLICAND,X
 2110         ADC SEED,X
 2120         STA SEED,X
 2130         DEX
 2140         BPL .3
 2150  .4     LDX BYTE.CNT
 2160         DEY
 2170         BNE .5
 2180         RTS
 2190  *--------------------------------
 2200  RANGE          .HS 81.00000000
 2210  FLT.SEED       .HS 80
 2220  SEED           .HS 00.00.00.00
 2230                 .HS 00        SIGN
 2240  A              .HS 12.B9.B0.A5   314159269
 2250  C              .HS 36.19.62.EB   907633386
 2260  MULTIPLIER     .BS 1
 2270  MULTIPLICAND   .BS 4
 2280  BYTE.CNT       .BS 1
 2290  *--------------------------------

